home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / CONTINUE.INC < prev    next >
Text File  |  1991-11-19  |  2KB  |  68 lines
  1. procedure CONTINUE;
  2. { CONTINUE waits for a user keypress before continuing, with the exception
  3.   of the following keys which have special meaning:
  4.     P  -  Pauses until P is pressed again (provides protection against an
  5.           accidental keypress clearing the screen).
  6.     S  -  Calls an internal screen dump routine (not implemented).
  7.     F  -  Dumps the current screen image into a PIC file.
  8. }
  9. var c: char;
  10.     Checkagain: boolean;
  11.     F: file;
  12.     i: integer;
  13.     Filefound: boolean;
  14.     Filename: text80;
  15.     Filenum: string;
  16.  
  17. begin
  18.   stopstat;               { erase the graphics status line }
  19.  
  20.   Checkagain := TRUE;
  21.   while (Checkagain) do begin
  22.     if (Save_cmmd <> '') then begin
  23.       { Command was entered on command line }
  24.       c := Save_cmmd[1];
  25.       Checkagain := FALSE;
  26.     end else
  27.       c := readkey;
  28.  
  29.     c := upcase (c);
  30.     case c of
  31.       'P' : begin  { Pause for another P }
  32.               c := ' ';
  33.               while (c <> 'P') do begin
  34.                 c := readkey;
  35.                 c := upcase (c);
  36.               end; {while}
  37.             end; {option P}
  38.       'S' : begin end; { insert a call to your screen dump here }
  39.       'F' : begin { Dump to a file }
  40.               Filefound := FALSE;
  41.               i := 1;
  42.               { Name the data file: search for first available number. }
  43.               while (i < 1000) and (not Filefound) do begin
  44.                 str (i, Filenum);
  45.                 Filename := Filemask + '.' + Filenum;
  46.                 assign (F, Filename);
  47.                 {$I-}
  48.                 reset (F);
  49.                 {$I+}
  50.                 if (ioresult <> 0) then
  51.                   Filefound := TRUE
  52.                 else begin
  53.                   close (F);
  54.                   i := i + 1;
  55.                 end;
  56.               end; { while }
  57.               if (not Filefound) then
  58.                 write (chr(7))
  59.               else
  60.                 if (not savescrn (Filename)) then
  61.                   write (chr(7));
  62.             end;
  63.       else
  64.         Checkagain := FALSE;
  65.     end {case}
  66.   end; { while Checkagain }
  67. end; { procedure CONTINUE }
  68.